home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / bpl70n12.zip / ARISOURC.ZIP / FPINT.ASM < prev    next >
Assembly Source File  |  1993-03-07  |  3KB  |  78 lines
  1.  
  2. ; *******************************************************
  3. ; *                                                     *
  4. ; *     Turbo Pascal Runtime Library Version 7.0        *
  5. ; *     Real Int Function                               *
  6. ; *                                                     *
  7. ; *     Copyright (C) 1989-1993 Norbert Juffa           *
  8. ; *                                                     *
  9. ; *******************************************************
  10.  
  11.              TITLE   FPINT
  12.  
  13.  
  14. CODE         SEGMENT BYTE PUBLIC
  15.  
  16.              ASSUME  CS:CODE
  17.  
  18. ; Publics
  19.  
  20.              PUBLIC  RInt
  21.  
  22. ;-------------------------------------------------------------------------------
  23. ; RInt represents the standard function Int. It computes the integral part of a
  24. ; TURBO-Pascal six byte floating point number, the result being a floating point
  25. ; number.
  26. ;
  27. ; INPUT:     DX:BX:AX  floating point number
  28. ;
  29. ; OUTPUT:    DX:BX:AX  integral part of floating point number
  30. ;
  31. ; DESTROYS:  AX,BX,CX,DX,SI,DI,Flags
  32. ;-------------------------------------------------------------------------------
  33.  
  34. RInt         PROC    FAR
  35.              CMP     AL, 0A8h          ; is argument > 2^39 ?
  36.              JNB     $no_change        ; yes, return number unchanged
  37.              CMP     AL, 80h           ; argument < 1 ?
  38.              JBE     $res_zero         ; yes, return zero
  39.              MOV     CX, AX            ; save
  40.              MOV     SI, BX            ;  original
  41.              MOV     DI, DX            ;   argument
  42.              CMP     AL, 88h           ; argument >= 2^7 ?
  43.              SBB     DH, DH            ; yes, DH=0 (else DH=FFh)
  44.              CMP     AL, 90h           ; argument >= 2^15 ?
  45.              SBB     DL, DL            ; yes, DL=0 (else DL=FFh)
  46.              CMP     AL, 98h           ; argument >= 2^23 ?
  47.              SBB     BH, BH            ; yes, BH=0 (else BH=FFh)
  48.              CMP     AL, 0A0h          ; argument >= 2^31 ?
  49.              SBB     BL, BL            ; yes, BL=0 (else BL=FFh)
  50.              NOT     DX                ; generate first
  51.              NOT     BX                ;  32 bits of mask
  52.              AND     AX, 7             ; clear LSB of mask, test if 1-bit shift
  53.              JZ      $shiftr_done      ; no further shifting required
  54.  
  55.              ALIGN   4
  56.  
  57. $shift_loop: ADD     AL, 0FFh          ; dec. shift counter, set carry flag
  58.              RCR     DX, 1             ; extend mask 1 bit
  59.              RCR     BX, 1             ;  to the
  60.              RCR     AH, 1             ;   right
  61.              JNZ     $shift_loop       ; shift until counter zero
  62. $shiftr_done:AND     DX, DI            ; mask out mantissa
  63.              AND     BX, SI            ;  bits containing
  64.              AND     CH, AH            ;   integral part of number
  65.              XCHG    AX, CX            ; get back exponent
  66.              RET                       ; done
  67. $res_zero:   XOR     AX, AX            ; load
  68.              MOV     BX, AX            ;   a
  69.              CWD                       ;    zero
  70. $no_change:  RET                       ; exit
  71. RInt         ENDP
  72.  
  73.              ALIGN   4
  74.  
  75. CODE         ENDS
  76.  
  77.              END
  78.